Speed-Proximity Analysis for DelDOT Model

Data Processing

Read in Data

zones <- st_read("K:\\Projects\\WILMAPCO\\Features\\Model\\SE\\Zones_2050.shp", quiet = TRUE) %>% 
  select(Zone)

zones <- ms_simplify(zones)

trips <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\skims_trips\\mr50_pk_am_trips.dbf")

skims <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\skims_trips\\mr50_congested_time_distance.dbf")

study_area_zones <- read.dbf("K:\\Projects\\WILMAPCO\\Features\\Model\\SE\\Zones_2050.dbf") %>% select(Zone, RFP_bound)

study_area_zones$RFP_bound <- replace_na(study_area_zones$RFP_bound, 0)

Calculate total AM trips by all modes (model does not contain nonmotorized) for all zone-to-zone flows

trips <- trips %>% 
  mutate(TRIPS = rowSums(.[3:12])) %>% 
  select(F_TAZ, T_TAZ, TRIPS)

skims_trips <- left_join(trips, skims)

Add MPH, PMT, PHT calculations for all zone-to-zone flows

skims_trips <- skims_trips %>% mutate(MPH = DIST / (TIME/60), 
                                      PMT = DIST * TRIPS,
                                      PHT = PMT / MPH)


skims_trips$MPH[is.nan(skims_trips$MPH)] <- 0
skims_trips$PMT[is.nan(skims_trips$PMT)] <- 0
skims_trips$PHT[is.nan(skims_trips$PHT)] <- 0

Summarize results to the “from persepctive”

#group by "from" TAZ and add up sum of relevant columns

from_summarized <- skims_trips %>% 
  select(-T_TAZ, -MPH) %>% 
  group_by(F_TAZ) %>% 
  summarise_all(sum) %>% 
  ungroup()
  
#calculate speed, length, and density based on summarized values

from_summarized <- from_summarized %>% 
  mutate(MPH = PMT/PHT, 
         LENGTH = PMT/TRIPS, 
         TRIP_DENSITY = 1/LENGTH)

Plot Results

Scatterplot of speed and trip density (all zones)

#add study area designation flag

from_summarized <- inner_join(from_summarized, study_area_zones, by = c("F_TAZ" = "Zone"))

from_summarized$RFP_zone[from_summarized$RFP_bound==1] <- "Study Area"
from_summarized$RFP_zone[from_summarized$RFP_bound==0] <- "Outside Study Area"

scatterplot <- ggplot(from_summarized, aes(x=TRIP_DENSITY, y=MPH, color = RFP_zone, text = paste0("TAZ: ", F_TAZ))) + 
  geom_point() +
  scale_color_rpg(palette = "rpg_colors")

ggplotly(scatterplot, tooltip = c("x", "y", "text")) %>% 
    layout(legend = list(orientation = "h", x = 0.4, y = -0.3))

Map of Trip Density by Origin TAZ

from_summarized_sf <- right_join(zones, from_summarized, 
                                 by = c("Zone" = "F_TAZ"))

tmap_mode("view")

pal <- rpg_color_pal("rpg_orange_ramp")(6)

tm_shape(from_summarized_sf) +
  tm_fill("TRIP_DENSITY", style="quantile", n = 6, palette = pal) +
  tm_borders(lwd = 0.5)

Table of Summarized Values by Origin TAZ

colnames <- colnames(from_summarized[2:9])

datatable(from_summarized) %>% formatRound(colnames)

Re-calculate “from perspective” after filtering to only include skim TAZs that appear in shapefile

#filter skims

skims_trips_filtered <- skims_trips %>% 
  filter(F_TAZ %in% zones$Zone,
         T_TAZ %in% zones$Zone)

#group filtered skims by "from" TAZ and add up sum of relevant columns

from_summarized_filtered <- skims_trips_filtered %>% 
  select(-T_TAZ, -MPH) %>% 
  group_by(F_TAZ) %>% 
  summarise_all(sum) %>% 
  ungroup()
  
#calculate speed, length, and density based on summarized values

from_summarized_filtered <- from_summarized_filtered %>% 
  mutate(MPH = PMT/PHT, 
         LENGTH = PMT/TRIPS, 
         TRIP_DENSITY = 1/LENGTH)

Scatterplot of filtered Speed and Trip Density

#add study area designation flag

from_summarized_filtered <- inner_join(from_summarized_filtered, study_area_zones, by = c("F_TAZ" = "Zone"))

from_summarized_filtered$RFP_zone[from_summarized_filtered$RFP_bound==1] <- "Study Area"
from_summarized_filtered$RFP_zone[from_summarized_filtered$RFP_bound==0] <- "Outside Study Area"

scatterplot_filtered <- ggplot(from_summarized_filtered, aes(x=TRIP_DENSITY, y=MPH, color = RFP_zone, text = paste0("TAZ: ", F_TAZ))) + 
  geom_point() +
  scale_color_rpg(palette = "rpg_colors")

ggplotly(scatterplot_filtered, tooltip = c("x", "y", "text")) %>% 
    layout(legend = list(orientation = "h", x = 0.4, y = -0.3))

Map of Filtered Trip Density by Origin TAZ

from_summarized_filtered_sf <- right_join(zones, from_summarized_filtered, 
                                 by = c("Zone" = "F_TAZ"))

tmap_mode("view")

pal <- rpg_color_pal("rpg_orange_ramp")(6)

tm_shape(from_summarized_filtered_sf) +
  tm_fill("TRIP_DENSITY", style="quantile", n = 6, palette = pal) +
  tm_borders(lwd = 0.5)

Table of Summarized Filtered Values by Origin TAZ

colnames <- colnames(from_summarized_filtered[2:9])

datatable(from_summarized_filtered) %>% formatRound(colnames)

#write_csv(from_summarized, "D:\\Users\\CO7\\OneDrive - Renaissance Planning Group\\Wilmapco\\from_scenario.csv")